home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / The World of Computer Software.iso / tcsel003.zip / HASH.PAS < prev    next >
Pascal/Delphi Source File  |  1992-10-16  |  3KB  |  100 lines
  1. UNIT Hash;
  2.  
  3. {***************************************************************************
  4.  *                                                                         *
  5.  *                     Copyright 1989 Trevor J Carlsen                     *
  6.  *                           All rights reserved                           *
  7.  *                   Rovert Software Consulting Services                   *
  8.  *                                PO Box 568                               *
  9.  *                   Port Hedland Western Australia 6721                   *
  10.  *                 Telephone  (091) 732026 or (091) 732569                 *
  11.  *                                                                         *
  12.  ***************************************************************************}
  13.  
  14. interface
  15.  
  16. uses strings,
  17.      sundry;
  18.  
  19. function hashcode(st : string; var nwd : word): word;
  20.  
  21. implementation
  22.  
  23. function MakeCodeStr(key : longint; st : string): string;
  24.   var
  25.     x   : word;
  26.     len : byte absolute st;
  27.   begin
  28.     RandSeed := (key * len) DIV ord(st[len]);
  29.     MakeCodeStr[0] := st[0];
  30.     for x := 1 to len do
  31.       MakeCodeStr[x] := chr(Random(255));
  32.   end;
  33.  
  34. function Key(st: string): longint;
  35.   var
  36.     len    : byte absolute st;
  37.     x,y    : byte;
  38.     temp   : longint;
  39.     tempst : array[0..3] of byte;
  40.  
  41.   procedure makekey(var k; var s : longint);
  42.     var t : longint absolute k;
  43.       rec : record
  44.               case byte of
  45.                1 :(b : longint; c : word);
  46.                2 :(d : word ; e : longint);
  47.                3 :(r : real);
  48.               end;
  49.     begin
  50.       RandSeed := t;
  51.       rec.r := random;
  52.       s := s xor rec.b xor rec.e;
  53.     end;
  54.  
  55.   begin
  56.     temp := 0;
  57.     for x := 1 to len-3 do begin
  58.       for y := 0 to 3 do
  59.         tempst[y] := byte(st[x + y]);
  60.       makekey(tempst,temp);
  61.     end;
  62.     Key := temp;
  63.   end;
  64.  
  65. function EncryptStr(key : longint; st : string): string;
  66.   var
  67.     len          : byte absolute st;
  68.     cnt,x        : byte;
  69.     temp,CodeStr : string;
  70.   begin
  71.     CodeStr := MakeCodeStr(key,st);
  72.     temp[0] := st[0];
  73.     temp[len] := st[len];
  74.     for x := 1 to len-1 do begin
  75.       cnt := ord(st[x]) xor ord(CodeStr[x]);
  76.       temp[x] := chr(cnt);
  77.       end;
  78.     cnt := ord(st[len]) xor len;
  79.     temp[len] := chr(cnt);
  80.     EncryptStr := temp;
  81.   end;
  82.  
  83. function hashcode(st : string; var nwd : word): word;
  84.   var k   : longint;
  85.       len : byte absolute st;
  86.       s   : string;
  87.   begin
  88.     k := key(st) * nwd;
  89.     st := StUpCase(st);
  90.     s := CompressStr(st);
  91.     move(s[1],nwd,2);
  92.     if len < 4 then st := st + '!@#$';
  93.     {-force string to a minimum length}
  94.     st := EncryptStr(k,st);
  95.     st := EncryptStr(Key(st),st);
  96.     hashcode := key(st) shr 16;
  97.   end;  {hash}
  98.  
  99. end.
  100.